home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / 2.01 sources / Examples-2.01 / icon-dialog-item.lisp < prev    next >
Encoding:
Text File  |  1993-09-16  |  7.4 KB  |  228 lines  |  [TEXT/CCL2]
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;
  3. ;;  icon-dialog-item.lisp
  4. ;;
  5. ;;
  6. ;;  Copyright ©1989, Apple Computer, Inc
  7. ;;
  8. ;;  this file defines icon dialog items which work like buttons.
  9. ;;
  10.  
  11.  
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13. ;;
  14. ;;  Change Log
  15. ;;  
  16. ;;
  17. ;; 04/28/93 mwp Release
  18. ;; 11/13/92   bill    "icon record" -> "icon handle" in plot-icon documentation   
  19. ;; 10/09/92   Cornell PLOT-ICON's first call to ERROR needed the icon argument.
  20. ;; ------------------ 2.0
  21. ;; 01/23/92   Matthew Cornell (cornell@cs.umass.edu): Defined an :after
  22. ;;                  method to (setf icon) that redraws the icon.
  23. ;; 12/18/91   bill  view-default-size, set-view-size
  24. ;; ---------------  2.0b4
  25. ;; 10/21/91   bill  New traps, :color-p initarg, don't cons macptr's
  26. ;;  8/22/90   Amy Bruckman         asb@media-lab.media.mit.edu
  27. ;;            Ported to 2.0.
  28. ;;           
  29.  
  30.  
  31. (in-package :ccl)
  32.  
  33. (eval-when (:compile-toplevel :load-toplevel :execute)
  34.   (export '(*stop-icon* *note-icon* *warn-icon* icon-dialog-item)
  35.           :ccl))
  36.  
  37.  
  38. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  39. ;;
  40. ;;  plot-icon
  41. ;;
  42. ;;  a function for displaying icons.  It can be passed a pointer or a number
  43. ;;    if passed a pointer, it assumes this is a pointer to an icon handle.
  44. ;;    if passed a number, it assumes this is the resource id of an icon.
  45. ;;    Draws to the current grafport, so call it inside WITH-FOCUSED-VIEW.
  46.  
  47. (defun plot-icon (icon point size &optional color-p)
  48.   "draws icon at point with given size"
  49.   (unless (or (typep icon 'fixnum)
  50.               (pointerp icon))
  51.     (error "~s is not a valid icon (not a resource-id or pointer" icon))
  52.   (with-macptrs ((resource (%null-ptr)))        ; don't cons macptr's
  53.     (without-interrupts
  54.      (when (typep icon 'fixnum)
  55.        (if color-p
  56.          (%setf-macptr resource (#_getCicon icon))
  57.          (%setf-macptr resource (#_geticon icon)))
  58.        (when (%null-ptr-p resource)
  59.          (error "no icon resource with id ~s ." icon))
  60.        (setq icon resource))
  61.      (rlet ((r :rect                         ;allocate a rectangle
  62.                :topleft point
  63.                :bottomright (add-points point size)))
  64.        (if color-p
  65.          (#_plotCicon r icon)
  66.          (#_ploticon r icon))))))
  67.  
  68.  
  69. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  70. ;;
  71. ;;  read in the three icons from system file and bind them to global variables.
  72. ;;
  73.  
  74. (defconstant *stop-icon* 0)
  75. (defconstant *note-icon* 1)
  76. (defconstant *warn-icon* 2)
  77.  
  78.  
  79. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  80. ;;
  81. ;;  icon-dialog-item
  82. ;;
  83. ;;  the new class inherits from dialog-item
  84. ;;
  85. ;;
  86.  
  87. (defclass icon-dialog-item (dialog-item)
  88.   ((icon :initform *note-icon* :initarg :my-icon :initarg :icon :accessor icon)
  89.    (color-p :initform nil :initarg :color-p :accessor color-p)))
  90.  
  91.  
  92. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  93. ;;
  94. ;;  (setf icon) :after
  95. ;;
  96.  
  97. (defmethod (setf icon) :after (icon (item icon-dialog-item))
  98.   "Invalidates item so that the new icon is drawn."
  99.   (declare (ignore icon))
  100.   (invalidate-view item t))
  101.  
  102.  
  103. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  104. ;;
  105. ;;  view-default-size
  106. ;;
  107.  
  108. (defmethod view-default-size ((view icon-dialog-item))
  109.   #@(32 32))
  110.  
  111.  
  112. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  113. ;;
  114. ;;  set-view-size
  115. ;;  The default method does not invalidate the old rectangle
  116. ;;
  117.  
  118. (defmethod set-view-size :before ((view icon-dialog-item) h &optional v)
  119.   (declare (ignore h v))
  120.   (invalidate-view view))
  121.  
  122.  
  123. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  124. ;;
  125. ;;  view-draw-contents
  126. ;;
  127. ;;this is the function called by the system whenever it needs to draw the item
  128. ;;
  129. ;;
  130.  
  131. (defmethod view-draw-contents ((item icon-dialog-item)) 
  132.   (plot-icon (icon item) (view-position item) (view-size item) (color-p item)))
  133.  
  134.  
  135. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  136. ;;
  137. ;;  view-click-event-handler
  138. ;;  
  139. ;;
  140. ;;  this function is called whenever the user clicks in the dialog item.  It
  141. ;;  is called on mouse-down, not on mouse-up.
  142. ;;
  143. ;;  the version defined below tracks the mouse, inverting the icon as long
  144. ;;  as the mouse is over it.  If the user releases the mouse-button while the
  145. ;;  the mouse is over the icon, the icon's dialog-item-action is called.
  146. ;;
  147. ;;
  148.  
  149. (defmethod view-click-event-handler ((item icon-dialog-item) where)
  150.   (declare (ignore where))
  151.   (let* ((pos (view-position item))
  152.          (inverted-p nil))              ;true when the mouse is over the icon
  153.     (with-focused-view (view-container item)   ;Draw in the container's coordinates
  154.       (rlet ((temp-rect :rect           ;temporarily allocate a rectangle
  155.                         :topLeft pos
  156.                         :botRight (add-points pos (view-size item))))
  157.         (without-interrupts                
  158.          (#_invertrect temp-rect)       ;initially invert the icon.
  159.          (setq inverted-p t)
  160.          (loop                          ;loop until the button is released
  161.            (unless (mouse-down-p)
  162.              (when inverted-p           ;if button released with mouse
  163.                                         ;  over the icon, run the action
  164.                (dialog-item-action item)
  165.                (#_invertrect temp-rect)
  166.                (setq inverted-p nil))
  167.              (return-from view-click-event-handler))
  168.            (if (#_PtInRect
  169.                 (view-mouse-position (view-window item))
  170.                 temp-rect)           ;is mouse over the icon's rect?
  171.              (unless inverted-p              ;yes, make sure it's inverted.
  172.                (#_invertrect temp-rect)
  173.                (setq inverted-p t))    
  174.              (when inverted-p                ;no, make sure it's not inverted.
  175.                (#_invertrect temp-rect)
  176.                (setq inverted-p nil)))))))))
  177.  
  178.  
  179.  
  180. (provide 'icon-dialog-item)
  181. (pushnew :icon-dialog-item *features*)
  182.  
  183.  
  184. #|
  185. ;;a sample call
  186.  
  187. (make-instance 'dialog
  188.        :view-size #@(244 84)
  189.        :window-title "Icons"
  190.        :view-position #@(150 125)
  191.        :window-type :document
  192.        :view-subviews
  193.        (list
  194.         (make-dialog-item 'icon-dialog-item
  195.                           #@(10 10)
  196.                           #@(32 32)
  197.                           "Untitled"
  198.                           #'(lambda (item)
  199.                             item
  200.                               (format *top-listener* "Hello stranger.")))
  201.         (make-dialog-item 'icon-dialog-item
  202.                           #@(60 10)
  203.                           #@(32 32)
  204.                           "Untitled"
  205.                           #'(lambda (item)
  206.                               item
  207.                               (format *top-listener* "That tickles!"))
  208.                           :icon *stop-icon*)
  209.         (make-dialog-item 'icon-dialog-item
  210.                           #@(110 10)
  211.                           #@(32 32)
  212.                           "Untitled"
  213.                           #'(lambda (item)
  214.                               item
  215.                               (format *top-listener* "Wow!"))
  216.                           :icon *warn-icon*)
  217.         (make-dialog-item 'icon-dialog-item
  218.                           #@(170 10)
  219.                           #@(64 64)
  220.                           "Untitled"
  221.                           #'(lambda (item)
  222.                               item
  223.                               (format *top-listener* "Scaling icons doesn't always look great."))
  224.                           :icon *note-icon*)))
  225.  
  226.  
  227. |#
  228.